-- metscrape - bulk-download weather forecasts.
-- Copyright (C) 2013  Jack Kelly <jack@jackkelly.name>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

module Scrapers.BOMText (transformXml) where

import Scraper
import Text
import Text.XML.HXT.Core

underline :: Char -> String -> String
underline ch text = text ++ "\n" ++ replicate (length text) ch

title doc = fmap ((++ "\n") . (underline '=') . head) $ runX $
            doc //> hasName "title" /> getText

date doc = fmap ((++ "\n\n") . head) $ runX $
           doc //> hasAttrValue "class" (== "date") //> getText

synopsis doc = fmap unlines $ runX $
               doc //> hasAttrValue "class" (== "synopsis")
                       /> ((hasName "h2"
                            >>> processChildren (changeText $ underline '-'))
                           <+> (hasName "p"
                                >>> processChildren (changeText trim)))
                       /> getText

days doc = fmap unlines $ runX $
           doc //> hasAttrValue "class" (== "day")
                   /> ((hasName "h2"
                        >>> (processChildren
                             $ changeText
                             $ ("\n" ++) . underline '-') /> getText)
                       <+> (hasAttrValue "class" (== "marine warning")
                            /> getText)
                       <+> ((getChildren
                             >>> ((hasName "dt" /> getText)
                                  <+> (hasName "dd"
                                       /> hasName "span"
                                       /> getText))
                             >>> (arr trim))
                            >>. merge)) where
                       merge [] = []
                       merge [s] = [s]
                       merge (s1:s2:ss) = (s1 ++ ": " ++ s2):(merge ss)

warning doc = fmap (("\n\n" ++) . concat) $ runX $
              doc //> hasAttrValue "class" (== "preamble")
                      /> ((hasName "strong" /> changeText (++ ": ")) <+> isText)
                      >>> getText

transformXml :: String -> IO String
transformXml xml = do
  let doc = readString [ withParseHTML yes, withWarnings no ] xml
  fmap concat
           $ sequence
           $ [ f doc | f <- [title, date, synopsis, days, warning] ]
